home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / ioaxcc / iodemo.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-08-03  |  24.2 KB  |  812 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "IO ActiveX Control Demo Application.                Visit: JSPayne.com"
  4.    ClientHeight    =   5970
  5.    ClientLeft      =   1335
  6.    ClientTop       =   1470
  7.    ClientWidth     =   8880
  8.    Height          =   6375
  9.    Left            =   1275
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   5970
  12.    ScaleWidth      =   8880
  13.    Top             =   1125
  14.    Width           =   9000
  15.    Begin VB.CommandButton CommandCancelIO 
  16.       Caption         =   "CancelIO()"
  17.       Height          =   255
  18.       Left            =   240
  19.       TabIndex        =   38
  20.       Top             =   1800
  21.       Width           =   1815
  22.    End
  23.    Begin VB.CommandButton CommandWriteFile 
  24.       Caption         =   "Write file to Port"
  25.       Height          =   255
  26.       Left            =   240
  27.       TabIndex        =   37
  28.       Top             =   2160
  29.       Width           =   1815
  30.    End
  31.    Begin VB.FileListBox File1 
  32.       Height          =   1035
  33.       Left            =   240
  34.       Pattern         =   "*.txt;*.bin"
  35.       TabIndex        =   36
  36.       Top             =   2400
  37.       Width           =   1815
  38.    End
  39.    Begin VB.CheckBox CheckAutoRead 
  40.       Caption         =   "Auto read on IOQueueEvent"
  41.       Height          =   195
  42.       Left            =   3120
  43.       TabIndex        =   35
  44.       Top             =   2160
  45.       Width           =   2895
  46.    End
  47.    Begin VB.CommandButton ClearWriteWin 
  48.       Caption         =   "Clear"
  49.       Height          =   255
  50.       Left            =   5280
  51.       TabIndex        =   34
  52.       Top             =   840
  53.       Width           =   1215
  54.    End
  55.    Begin VB.CommandButton ClearReadWin 
  56.       Caption         =   "Clear"
  57.       Height          =   255
  58.       Left            =   5280
  59.       TabIndex        =   33
  60.       Top             =   2400
  61.       Width           =   1215
  62.    End
  63.    Begin VB.CheckBox CheckSym 
  64.       Caption         =   "Use symbols for binary data. Ex:<ESC>"
  65.       Height          =   195
  66.       Left            =   2880
  67.       TabIndex        =   32
  68.       Top             =   600
  69.       Width           =   3135
  70.    End
  71.    Begin VB.CommandButton Command6 
  72.       Caption         =   "ReadData()"
  73.       Height          =   255
  74.       Left            =   3840
  75.       TabIndex        =   29
  76.       Top             =   2400
  77.       Width           =   1455
  78.    End
  79.    Begin VB.CommandButton Command5 
  80.       Caption         =   "WriteData()"
  81.       Height          =   255
  82.       Left            =   3840
  83.       TabIndex        =   28
  84.       Top             =   840
  85.       Width           =   1455
  86.    End
  87.    Begin VB.CommandButton PortSettingsButton 
  88.       Caption         =   "Serial Port Settings"
  89.       Height          =   255
  90.       Left            =   240
  91.       TabIndex        =   26
  92.       Top             =   1560
  93.       Width           =   1815
  94.    End
  95.    Begin VB.Frame Frame2 
  96.       Caption         =   "I/O Events"
  97.       Height          =   2175
  98.       Left            =   120
  99.       TabIndex        =   22
  100.       Top             =   3720
  101.       Width           =   8655
  102.       Begin VB.CommandButton Command7 
  103.          Caption         =   "Clear Event List"
  104.          Height          =   255
  105.          Left            =   4920
  106.          TabIndex        =   30
  107.          Top             =   600
  108.          Width           =   1815
  109.       End
  110.       Begin VB.CheckBox Check6 
  111.          Caption         =   "Enable Periodic Event"
  112.          Height          =   255
  113.          Left            =   240
  114.          TabIndex        =   27
  115.          Top             =   240
  116.          Width           =   2895
  117.       End
  118.       Begin VB.TextBox EventIntervalText 
  119.          Height          =   285
  120.          Left            =   3120
  121.          TabIndex        =   25
  122.          Top             =   600
  123.          Width           =   735
  124.       End
  125.       Begin VB.TextBox TextEvents 
  126.          Height          =   1215
  127.          Left            =   120
  128.          MultiLine       =   -1  'True
  129.          ScrollBars      =   2  'Vertical
  130.          TabIndex        =   23
  131.          Top             =   960
  132.          Width           =   8415
  133.       End
  134.       Begin VB.Label Label7 
  135.          Caption         =   "StatusEventInterval (Event Sensitivity)"
  136.          Height          =   255
  137.          Left            =   240
  138.          TabIndex        =   24
  139.          Top             =   600
  140.          Width           =   2895
  141.       End
  142.    End
  143.    Begin VB.Frame Frame1 
  144.       Caption         =   "Status by Polling"
  145.       Height          =   3015
  146.       Left            =   6600
  147.       TabIndex        =   10
  148.       Top             =   600
  149.       Width           =   2175
  150.       Begin VB.CheckBox Check5 
  151.          Caption         =   "Power Off"
  152.          Height          =   255
  153.          Left            =   840
  154.          TabIndex        =   21
  155.          Top             =   1200
  156.          Width           =   1095
  157.       End
  158.       Begin VB.CheckBox Check18 
  159.          Caption         =   "RLSD On"
  160.          Height          =   255
  161.          Left            =   840
  162.          TabIndex        =   20
  163.          Top             =   2400
  164.          Width           =   1095
  165.       End
  166.       Begin VB.CheckBox Check17 
  167.          Caption         =   "Ring On"
  168.          Height          =   255
  169.          Left            =   840
  170.          TabIndex        =   19
  171.          Top             =   2160
  172.          Width           =   975
  173.       End
  174.       Begin VB.CheckBox Check16 
  175.          Caption         =   "DSR On"
  176.          Height          =   255
  177.          Left            =   840
  178.          TabIndex        =   18
  179.          Top             =   1920
  180.          Width           =   1095
  181.       End
  182.       Begin VB.CheckBox Check15 
  183.          Caption         =   "CTS On"
  184.          Height          =   255
  185.          Left            =   840
  186.          TabIndex        =   17
  187.          Top             =   1680
  188.          Width           =   975
  189.       End
  190.       Begin VB.CheckBox Check4 
  191.          Caption         =   "Busy"
  192.          Height          =   255
  193.          Left            =   840
  194.          TabIndex        =   14
  195.          Top             =   960
  196.          Width           =   735
  197.       End
  198.       Begin VB.CheckBox Check3 
  199.          Caption         =   "Paper Empty"
  200.          Height          =   255
  201.          Left            =   840
  202.          TabIndex        =   13
  203.          Top             =   720
  204.          Width           =   1215
  205.       End
  206.       Begin VB.CheckBox Check2 
  207.          Caption         =   "Selected"
  208.          Height          =   255
  209.          Left            =   840
  210.          TabIndex        =   12
  211.          Top             =   480
  212.          Width           =   975
  213.       End
  214.       Begin VB.CheckBox Check1 
  215.          Caption         =   "Off Line"
  216.          Height          =   255
  217.          Left            =   840
  218.          TabIndex        =   11
  219.          Top             =   240
  220.          Width           =   975
  221.       End
  222.       Begin VB.Timer Timer1 
  223.          Interval        =   500
  224.          Left            =   240
  225.          Top             =   2160
  226.       End
  227.       Begin VB.Label Label6 
  228.          Caption         =   "Serial:"
  229.          Height          =   255
  230.          Left            =   240
  231.          TabIndex        =   16
  232.          Top             =   1680
  233.          Width           =   495
  234.       End
  235.       Begin VB.Label Label5 
  236.          Caption         =   "Parallel:"
  237.          Height          =   255
  238.          Left            =   120
  239.          TabIndex        =   15
  240.          Top             =   240
  241.          Width           =   615
  242.       End
  243.    End
  244.    Begin VB.TextBox TextRead 
  245.       Height          =   975
  246.       Left            =   2280
  247.       MultiLine       =   -1  'True
  248.       ScrollBars      =   2  'Vertical
  249.       TabIndex        =   8
  250.       Top             =   2640
  251.       Width           =   4215
  252.    End
  253.    Begin VB.TextBox TextWrite 
  254.       Height          =   975
  255.       Left            =   2280
  256.       MultiLine       =   -1  'True
  257.       ScrollBars      =   2  'Vertical
  258.       TabIndex        =   7
  259.       Text            =   "IODemo.frx":0000
  260.       Top             =   1080
  261.       Width           =   4215
  262.    End
  263.    Begin VB.CommandButton Command4 
  264.       Caption         =   "Close() Port"
  265.       Height          =   255
  266.       Left            =   240
  267.       TabIndex        =   6
  268.       Top             =   1320
  269.       Width           =   1815
  270.    End
  271.    Begin VB.CommandButton Command3 
  272.       Caption         =   "ReadString()"
  273.       Height          =   255
  274.       Left            =   2280
  275.       TabIndex        =   5
  276.       Top             =   2400
  277.       Width           =   1575
  278.    End
  279.    Begin VB.CommandButton Command2 
  280.       Caption         =   "WriteString()"
  281.       Height          =   255
  282.       Left            =   2280
  283.       TabIndex        =   4
  284.       Top             =   840
  285.       Width           =   1575
  286.    End
  287.    Begin VB.CommandButton Command1 
  288.       Caption         =   "Open() Port for I/O"
  289.       Height          =   255
  290.       Left            =   240
  291.       TabIndex        =   3
  292.       Top             =   1080
  293.       Width           =   1815
  294.    End
  295.    Begin VB.ComboBox Combo1 
  296.       Height          =   315
  297.       Left            =   240
  298.       TabIndex        =   2
  299.       Text            =   "Select a Port"
  300.       Top             =   720
  301.       Width           =   1815
  302.    End
  303.    Begin VB.OptionButton Option2 
  304.       Caption         =   "Background I/O (Mode = 2)"
  305.       Height          =   255
  306.       Left            =   240
  307.       TabIndex        =   1
  308.       Top             =   360
  309.       Width           =   2535
  310.    End
  311.    Begin VB.OptionButton Option1 
  312.       Caption         =   "Normal I/O (Mode = 0)"
  313.       Height          =   255
  314.       Left            =   240
  315.       TabIndex        =   0
  316.       Top             =   120
  317.       Width           =   1935
  318.    End
  319.    Begin VB.Label Label1 
  320.       Alignment       =   2  'Center
  321.       Caption         =   "Binary data as <value> Ex: <27>"
  322.       Height          =   255
  323.       Left            =   2520
  324.       TabIndex        =   31
  325.       Top             =   360
  326.       Width           =   3735
  327.    End
  328.    Begin VB.Label Label4 
  329.       BackStyle       =   0  'Transparent
  330.       Caption         =   "Select a port. Open the Port. Write/Read to/from the Port."
  331.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  332.          Name            =   "MS Sans Serif"
  333.          Size            =   8.25
  334.          Charset         =   0
  335.          Weight          =   700
  336.          Underline       =   0   'False
  337.          Italic          =   0   'False
  338.          Strikethrough   =   0   'False
  339.       EndProperty
  340.       Height          =   255
  341.       Left            =   2280
  342.       TabIndex        =   9
  343.       Top             =   120
  344.       Width           =   6615
  345.    End
  346.    Begin IOLib.IO IO1 
  347.       Left            =   8040
  348.       Top             =   0
  349.       _Version        =   65536
  350.       _ExtentX        =   1270
  351.       _ExtentY        =   1270
  352.       _StockProps     =   0
  353.    End
  354. Attribute VB_Name = "Form1"
  355. Attribute VB_Creatable = False
  356. Attribute VB_Exposed = False
  357. Public PortName As String
  358. Public PortOpen As Integer
  359. Public PerEventCounter As Integer
  360. Public EventCounter As Integer
  361. Private Symbols(32) As String
  362. Private Sub Check6_Click()
  363. If Form1.Check6 = 0 Then
  364. IO1.PeriodicEventEnabled = False
  365. 'Form1.Option3 = False
  366. IO1.PeriodicEventEnabled = True
  367. 'Form1.Option3 = False
  368. End If
  369. End Sub
  370. Private Sub ClearReadWin_Click()
  371. TextRead.Text = ""
  372. End Sub
  373. Private Sub ClearWriteWin_Click()
  374. TextWrite.Text = ""
  375. End Sub
  376. Private Sub Combo1_Click()
  377. IO1.Close
  378. PortOpen = False
  379. PortName = Combo1.Text
  380. End Sub
  381. Private Sub Command1_Click()
  382. Dim Result As Integer
  383. PortName = Combo1.Text
  384. If (Left(PortName, 6) = "Select") Then
  385. MsgBox ("You Must select a port before you can Open a port.")
  386. Exit Sub
  387. End If
  388. If PortOpen = True Then
  389. IO1.Close
  390. PortOpen = False
  391. End If
  392. If (Left(PortName, 3) = "COM") Or (Left(PortName, 7) = "\\.\COM") Then
  393. 'Result = IO1.Open(PortName, "baud=9600 parity=N data=7 stop=1")
  394. Result = IO1.Open(PortName, "baud=9600 parity=N data=8 stop=1")
  395. 'IO1.SetHandshaking (HS_HARDWARE)
  396. MsgBox ("The serial port is opened with the following settings: baud=9600 parity=N data=8 stop=1 (no handshaking)")
  397. PortSettingsButton.Enabled = True
  398. Result = IO1.Open(PortName, "")
  399. PortSettingsButton.Enabled = False
  400. End If
  401. If (Result = 0) Then
  402. MsgBox ("Open failed, Ensure other devices/drivers are not using this port.")
  403. PortOpen = False
  404. PortOpen = True
  405. IO1.StatusEventInterval = 25
  406. EventIntervalText.Text = Format(IO1.StatusEventInterval)
  407. End If
  408. 'IO1.StatusEventInterval = 10
  409. End Sub
  410. Private Sub Command2_Click()
  411. Dim Strng As String
  412. If PortOpen = False Then
  413. MsgBox ("Port is not open, you must open a port before writing data.")
  414. Exit Sub
  415. End If
  416. Strng = ConvertToBin(TextWrite.Text)
  417. 'Strng = TextWrite.Text
  418. Result = IO1.WriteString(Strng)
  419. If (Result = 0) Then
  420.   MsgBox ("WriteString failed, make sure device is connected and port is opened.")
  421. End If
  422. End Sub
  423. Private Sub Command3_Click()
  424. If PortOpen = False Then
  425. MsgBox ("Port is not open, you must open a port before reading data.")
  426. Exit Sub
  427. End If
  428. TextRead.Text = TextRead.Text + ConvertFromBin(IO1.ReadString(50))
  429. End Sub
  430. Private Sub Command4_Click()
  431. IO1.Close
  432. PortOpen = False
  433. End Sub
  434. Private Sub Command5_Click()
  435. Dim Strng As String
  436. If PortOpen = False Then
  437. MsgBox ("Port is not open, you must open a port before writing data.")
  438. Exit Sub
  439. End If
  440. Strng = ConvertToBin(TextWrite.Text)
  441. Result = IO1.WriteData(Strng, Len(Strng))
  442. If (Result = 0) Then
  443.   MsgBox ("WriteString failed, make sure device is connected and port is opened.")
  444. End If
  445. End Sub
  446. Private Sub Command6_Click()
  447. If PortOpen = False Then
  448. MsgBox ("Port is not open, you must open a port before reading data.")
  449. End If
  450. TextRead.Text = TextRead.Text + ConvertFromBin(IO1.ReadData(50))
  451. End Sub
  452. Private Sub Command7_Click()
  453. TextEvents.Text = ""
  454. End Sub
  455. Private Sub Command8_Click()
  456. ret = IO1.DeviceControl(1441800, 3, "")
  457. End Sub
  458. Private Sub CommandCancelIO_Click()
  459. IO1.CancelIO (CANCEL_TXABORT + CANCEL_RXABORT + CANCEL_TXCLEAR + CANCEL_RXCLEAR)
  460. End Sub
  461. Private Sub CommandWriteFile_Click()
  462. Dim InputData As Byte
  463. Dim st As String
  464. Dim Data As String
  465. Dim Count As Integer
  466. If PortOpen = False Then
  467. MsgBox ("Port is not open, you must open a port before writing data.")
  468. Exit Sub
  469. End If
  470. st = File1.Path + "\" + File1.filename
  471. Open st For Binary As #1
  472. Do While Not EOF(1) ' Check for end of file.
  473.     Get #1, , InputData
  474.     Data = Data + Chr(InputData)
  475.     Count = Count + 1
  476.     If (Count > 100) Then
  477.         If (IO1.WriteData(Data, Count) = 0) Then
  478.             MsgBox "WriteData() failed, writing file to port aborted."
  479.             Close #1    ' Close file.
  480.             Exit Sub
  481.         End If
  482.         DoEvents     'allow events to be fired
  483.         'IO1.Wait (4) 'allow events to be fired
  484.         Data = ""
  485.         Count = 0
  486.     End If
  487. If (IO1.WriteData(Data, Count) = 0) Then
  488.     MsgBox "WriteData() failed, writing file to port aborted."
  489. End If
  490. Close #1    ' Close file.
  491. End Sub
  492. Private Sub EventIntervalText_Change()
  493. IO1.StatusEventInterval = Val(EventIntervalText.Text)
  494. End Sub
  495. Private Sub Form_Load()
  496. For i = 0 To 10
  497. Combo1.AddItem IO1.ListPorts(i, 3)
  498. Next i
  499. If File1.ListCount <> 0 Then
  500.     File1.Selected(0) = 1
  501. End If
  502. Symbols(0) = "NULL"
  503. Symbols(1) = "SOH"
  504. Symbols(2) = "STX"
  505. Symbols(3) = "ETX"
  506. Symbols(4) = "EOT"
  507. Symbols(5) = "ENQ"
  508. Symbols(6) = "ACK"
  509. Symbols(7) = "BEL"
  510. Symbols(8) = "BS>"
  511. Symbols(9) = "HT>"
  512. Symbols(10) = "LF>"
  513. Symbols(11) = "VT>"
  514. Symbols(12) = "FF>"
  515. Symbols(13) = "CR>"
  516. Symbols(14) = "SO>"
  517. Symbols(15) = "SI>"
  518. Symbols(16) = "DEL"
  519. Symbols(17) = "DC1"
  520. Symbols(18) = "DC2"
  521. Symbols(19) = "DC3"
  522. Symbols(20) = "DC4"
  523. Symbols(21) = "NAK"
  524. Symbols(22) = "SYN"
  525. Symbols(23) = "ETB"
  526. Symbols(24) = "CAN"
  527. Symbols(25) = "EM>"
  528. Symbols(26) = "SUB"
  529. Symbols(27) = "ESC"
  530. Symbols(28) = "FS>"
  531. Symbols(29) = "GS>"
  532. Symbols(30) = "RS>"
  533. Symbols(31) = "US>"
  534. End Sub
  535. Private Sub Form_Unload(Cancel As Integer)
  536. IO1.Close
  537. End Sub
  538. Private Sub IO1_IOCompleteEvent(ByVal JobType As Long, ByVal JobId As Long, ByVal JobResult As Long)
  539. Dim NewText As String
  540. EventCounter = EventCounter + 1
  541. If (JobType = BKJOB_WRITE) Then
  542. NewText = "#" + Str(EventCounter) + " [IOCompleteEvent]    Background Write Done,   Job ID: " + Format(JobId) + "   Job Result: " + Format(JobResult)
  543. End If
  544. If (JobType = BKJOB_READ) Then
  545. NewText = "#" + Str(EventCounter) + " [IOCompleteEvent]    Background Read Done,   Job ID: " + Format(JobId) + "   Job Result: " + Format(JobResult)
  546. TextRead.Text = TextRead.Text + ConvertFromBin(IO1.DataBuffer)
  547. End If
  548. AddTextToEventWin (NewText)
  549. End Sub
  550. Private Sub IO1_IOPeriodicEvent()
  551. Dim NewText As String
  552. EventCounter = EventCounter + 1
  553. If EventCounter > 500 Then
  554. EventCounter = 0
  555. TextEvents.Text = ""
  556. End If
  557. PerEventCounter = PerEventCounter + 1
  558. NewText = "#" + Str(EventCounter) + " [IOPeriodicEvent] #" + Str(PerEventCounter)
  559. AddTextToEventWin (NewText)
  560. End Sub
  561. Private Sub IO1_IOQueueEvent(ByVal NumCharsInputQue As Long, ByVal NumCharsOutputQue As Long)
  562. Dim NewText As String
  563. If (CheckAutoRead = 1 And NumCharsInputQue > 0) Then
  564. 'While (IO1.NumCharsInQue)
  565. If IO1.Mode = 0 Then
  566.     TextRead.Text = TextRead.Text + ConvertFromBin(IO1.ReadData(20))
  567.     IO1.ReadData (20)
  568. End If
  569. 'Wend
  570. End If
  571. EventCounter = EventCounter + 1
  572. NewText = "#" + Str(EventCounter) + " [IOQueueEvent]    Input Queue:" + Format(NumCharsInputQue) + "   Output Queue: " + Format(NumCharsOutputQue)
  573. AddTextToEventWin (NewText)
  574. End Sub
  575. Private Sub IO1_IOStatusEvent(ByVal StatusType As Long, ByVal IOStatus As Long)
  576. Dim NewText As String
  577. EventCounter = EventCounter + 1
  578. 'Handle Parallel Events
  579. If (StatusType = STATUS_TYPE_PARALLEL) Then
  580. NewText = "#" + Str(EventCounter) + " [IOStatusEvent]    Status Event: "
  581. If (IOStatus And PARALLEL_PAPER_EMPTY) Then
  582. NewText = NewText + "Paper Empty, "
  583. NewText = NewText + "Paper Ok, "
  584. End If
  585. If (IOStatus And PARALLEL_OFF_LINE) Then
  586. NewText = NewText + "Off Line, "
  587. NewText = NewText + "On Line, "
  588. End If
  589. If (IOStatus And PARALLEL_POWER_OFF) Then
  590. NewText = NewText + "Power Off, "
  591. NewText = NewText + "Power On, "
  592. End If
  593. If (IOStatus And PARALLEL_NOT_CONNECTED) Then
  594. NewText = NewText + "Not Connected, "
  595. NewText = NewText + "Connected, "
  596. End If
  597. If (IOStatus And PARALLEL_BUSY) Then
  598. NewText = NewText + "Busy, "
  599. NewText = NewText + "Not Busy, "
  600. End If
  601. If (IOStatus And PARALLEL_SELECTED) Then
  602. NewText = NewText + "Selected. "
  603. NewText = NewText + "Not Selected. "
  604. End If
  605. End If
  606. 'Handle Serial Events
  607. If (StatusType = STATUS_TYPE_SERIAL) Then
  608. NewText = "#" + Str(EventCounter) + " [IOStatusEvent]    Status Event: "
  609. If (IOStatus And SERIAL_RXOVER) Then
  610. NewText = NewText + "RX Buffer Overrun, "
  611. End If
  612. If (IOStatus And SERIAL_RXPARITY) Then
  613. NewText = NewText + "RX Pariety Error, "
  614. End If
  615. If (IOStatus And SERIAL_FRAME) Then
  616. NewText = NewText + "RX Framing Error, "
  617. End If
  618. If (IOStatus And SERIAL_BREAK) Then
  619. NewText = NewText + "Serial Break Occured, "
  620. End If
  621. If (IOStatus And SERIAL_TXFULL) Then
  622. NewText = NewText + "TX Buffer Full, "
  623. End If
  624. If (IOStatus And SERIAL_TXEMPTY) Then
  625. NewText = NewText + "TX Buffer Empty, "
  626. NewText = NewText + "TX Buffer Not Empty, "
  627. End If
  628. If (IOStatus And SERIAL_RXEMPTY) Then
  629. NewText = NewText + "RX Buffer Empty, "
  630. elseNewText = NewText + "RX Buffer Not Empty, "
  631. End If
  632. If (IOStatus And SERIAL_CTS_TXHOLD) Then
  633. NewText = NewText + "TX Hold due to CTS, "
  634. End If
  635. If (IOStatus And SERIAL_DSR_TXHOLD) Then
  636. NewText = NewText + "TX Hold due to DSR, "
  637. End If
  638. If (IOStatus And SERIAL_RLSD_TXHOLD) Then
  639. NewText = NewText + "TX Hold due to RLSD, "
  640. End If
  641. If (IOStatus And SERIAL_XOFF_TXHOLD) Then
  642. NewText = NewText + "TX Hold due to XOFF, "
  643. End If
  644. If (IOStatus And SERIAL_CTS_ON) Then
  645. NewText = NewText + "CTS On, "
  646. End If
  647. If (IOStatus And SERIAL_DSR_ON) Then
  648. NewText = NewText + "DSR On, "
  649. End If
  650. If (IOStatus And SERIAL_RING_ON) Then
  651. NewText = NewText + "Ring On, "
  652. End If
  653. If (IOStatus And SERIAL_RLSD_ON) Then
  654. NewText = NewText + "RLSD On, "
  655. End If
  656. End If
  657. If (Len(TextEvents.Text) > 5000) Then
  658. 'TextEvents.Text = Left(TextEvents.Text, 300)
  659. TextEvents.Text = ""
  660. End If
  661. AddTextToEventWin (NewText)
  662. End Sub
  663. Private Sub IO2_IOPeriodicEvent()
  664. Dim NewText As String
  665. EventCounter = EventCounter + 1
  666. If EventCounter > 500 Then
  667. EventCounter = 0
  668. TextEvents.Text = ""
  669. End If
  670. PerEventCounter = PerEventCounter + 1
  671. NewText = "#" + Str(EventCounter) + " [IOPeriodicEvent] #" + Str(PerEventCounter)
  672. AddTextToEventWin (NewText)
  673. End Sub
  674. Private Sub Option1_Click()
  675. IO1.Mode = MODE_NORMAL
  676. End Sub
  677. Private Sub Option2_Click()
  678. IO1.Mode = MODE_ASYNC
  679. End Sub
  680. Private Sub PortSettingsButton_Click()
  681. IO1.SerialGetPortDefaults (PortName)
  682. Result = IO1.SerialPortSetupDialog(PortName)
  683. If Result = 1 Then
  684.     Result = IO1.SerialSetPortDefaults(PortName, "", -1)
  685. End If
  686. End Sub
  687. Private Sub Timer1_Timer()
  688. Dim Result As Long
  689. Result = IO1.ParallelStatus
  690. If (Result = -1) Then
  691.  Check1.Enabled = False
  692.  Check2.Enabled = False
  693.  Check3.Enabled = False
  694.  Check4.Enabled = False
  695.  Check5.Enabled = False
  696.  Check1.Enabled = True
  697.  Check2.Enabled = True
  698.  Check3.Enabled = True
  699.  Check4.Enabled = True
  700.  Check5.Enabled = True
  701.  If (Result And PARALLEL_OFF_LINE) Then
  702.  Check1.Value = 1
  703.  Else
  704.  Check1.Value = 0
  705.  End If
  706.  If (Result And PARALLEL_SELECTED) Then
  707.  Check2.Value = 1
  708.  Else
  709.  Check2.Value = 0
  710.  End If
  711.  If (Result And PARALLEL_PAPER_EMPTY) Then
  712.  Check3.Value = 1
  713.  Else
  714.  Check3.Value = 0
  715.  End If
  716.  If (Result And PARALLEL_BUSY) Then
  717.  Check4.Value = 1
  718.  Else
  719.  Check4.Value = 0
  720.  End If
  721.  If (Result And PARALLEL_POWER_OFF) Then
  722.  Check5.Value = 1
  723.  Else
  724.  Check5.Value = 0
  725.  End If
  726. End If
  727. Result = IO1.SerialStatus
  728. If (Result = -1) Then
  729.  Check15.Enabled = False
  730.  Check16.Enabled = False
  731.  Check17.Enabled = False
  732.  Check18.Enabled = False
  733.  Check15.Enabled = True
  734.  Check16.Enabled = True
  735.  Check17.Enabled = True
  736.  Check18.Enabled = True
  737.  If (Result And SERIAL_CTS_ON) Then
  738.  Check15.Value = 1
  739.  Else
  740.  Check15.Value = 0
  741.  End If
  742.  If (Result And SERIAL_DSR_ON) Then
  743.  Check16.Value = 1
  744.  Else
  745.  Check16.Value = 0
  746.  End If
  747.  If (Result And SERIAL_RING_ON) Then
  748.  Check17.Value = 1
  749.  Else
  750.  Check17.Value = 0
  751.  End If
  752.  If (Result And SERIAL_RLSD_ON) Then
  753.  Check18.Value = 1
  754.  Else
  755.  Check18.Value = 0
  756.  End If
  757. End If
  758. End Sub
  759. Public Function AddTextToEventWin(NewText As String) As String
  760. TextEvents.Text = TextEvents.Text + Chr(13) + Chr(10) + NewText
  761. TextEvents.SelStart = Len(TextEvents.Text)
  762. End Function
  763. Public Function ConvertFromBin(Strng As String) As String
  764. Dim NewStr As String
  765. Dim Value As Integer
  766. Dim Number As String
  767. For n = 1 To Len(Strng)
  768. If Mid(Strng, n, 1) < " " Then
  769. Value = Asc(Mid(Strng, n, 1))
  770. Number = Format(Value)
  771. If CheckSym = 1 Then
  772.     If Right(Symbols(Value), 1) = ">" Then
  773.     NewStr = NewStr + "<" + Symbols(Value)
  774.     Else
  775.     NewStr = NewStr + "<" + Symbols(Value) + ">"
  776.     End If
  777.     NewStr = NewStr + "<" + Number + ">"
  778. End If
  779. NewStr = NewStr + Mid(Strng, n, 1)
  780. End If
  781. Next n
  782. ConvertFromBin = NewStr
  783. End Function
  784. Public Function ConvertToBin(Strng As String) As String
  785. Dim NewStr As String
  786. Dim Number As Integer
  787. For n = 1 To Len(Strng)
  788. If (Mid(Strng, n, 1)) = "<" Then
  789. Number = Val(Mid(Strng, n + 1, 3))
  790.     If Number = 0 And Mid(Strng, n + 1, 1) <> "0" Then
  791.         For Number = 0 To 30
  792.         If Left(Symbols(Number), 3) = Mid(Strng, n + 1, 3) Then Exit For
  793.         Next Number
  794.         NewStr = NewStr + Chr(Number)
  795.         If Right(Symbols(Number), 1) = ">" Then
  796.         n = n + Len(Symbols(Number))
  797.         Else
  798.         n = n + Len(Symbols(Number)) + 1
  799.         End If
  800.         'n = n + 3
  801.     Else
  802.         NewStr = NewStr + Chr(Number)
  803.         n = n + 2
  804.         If (Number >= 10) Then n = n + 1
  805.         If (Number >= 100) Then n = n + 1
  806.     End If
  807. NewStr = NewStr + Mid(Strng, n, 1)
  808. End If
  809. Next n
  810. ConvertToBin = NewStr
  811. End Function
  812.